home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / User Contributions / Misc.sea / Misc / ift-icon-dialog-item.lisp < prev    next >
Encoding:
Text File  |  1993-02-26  |  2.3 KB  |  61 lines  |  [TEXT/CCL2]
  1. ;;; Extension to IFT for icon-dialog-items
  2. ;;; by Daniel LaLiberte (liberte@ncsa.uiuc.edu)  July 1992
  3.  
  4. ;;; I use oodles-of-utils to set up the resource file where the icon resides.
  5. ;;; Problem: make sure you are using a valid icon resource ID or you 
  6. ;;; may crash MCL or worse.
  7.  
  8. #| Load up the interface builder and extensions.
  9. (load "ccl:Interface Tools;make-ift")
  10. (ift::load-ift)
  11. (load "ccl:Interface Tools;ift-icon-dialog-item")
  12. (load "ccl:Interface Tools;ift-pop-up-menu")
  13. |#
  14.  
  15. (in-package :interface-tools)
  16.  
  17. (require :icon-dialog-item)
  18.  
  19.  
  20. (add-editable-dialog-item (make-instance 'ccl:icon-dialog-item
  21.                                          :icon ccl:*note-icon*))
  22. ;; (remove-editable-dialog-item 'ccl:icon-dialog-item)
  23. ;; (remove-editable-dialog-item 'ccl:array-dialog-item)
  24.  
  25.  
  26. (defmethod add-editor-items :after ((icon-item ccl:icon-dialog-item) editor)
  27.   (let* ((position *editor-items-start-pos*)
  28.          (size #@(116 16))
  29.          (delta (make-point 0 (+ (point-v size) 5))))
  30.     (add-subviews 
  31.      editor
  32.      (make-dialog-item 'check-box-dialog-item
  33.                          position size "Color Icon"
  34.                          #'(lambda (item)
  35.                              (setf (ccl::color-p icon-item)
  36.                                    (check-box-checked-p item))
  37.                              (invalidate-view icon-item t)
  38.                              )
  39.                          :check-box-checked-p (ccl::color-p icon-item))
  40.      (make-dialog-item 'button-dialog-item
  41.                        (setq position (add-points position delta))
  42.                        size "Set icon #"
  43.                        #'(lambda (item)
  44.                              (declare (ignore item))
  45.                              (setf (ccl::icon icon-item)
  46.                                    (read-from-string
  47.                                     (get-string-from-user
  48.                                      "Please enter a new icon number for the icon."
  49.                                      :initial-string
  50.                                      (format nil "~s" (ccl::icon icon-item)))))
  51.                              ;;(invalidate-view icon-item t) not needed now.
  52.                              ))
  53.      )))
  54.  
  55.  
  56. (defmethod object-source-code ((item ccl:icon-dialog-item))
  57.   (nconc (call-next-method)
  58.          `(:color-p ,(ccl::color-p item))
  59.          `(:icon ,(ccl::icon item))
  60.          ))
  61.